{***************************************************************
    SpyGestion  Copyright (C) 2008 Christophe KOALI <nature2gas@gmail.com>
    
    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.
    
    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.
    
    You should have received a copy of the GNU General Public License
    along with this program.  If not, see <http://www.gnu.org/licenses/>.
    
****************************************************************}
unit modBoardLittleMotor;

interface

uses Classes,
     SysUtils,
     modBoardConst,
     modGestionDownload,
     sFonctionsChaines,
     HttpProt,
     LibXmlParser, LibXmlComps,
     modMd5,
     ESBDates,

     modGestionDLGZip;


type
     TBoardFonctionLoginResult = (tbflSuccess,
                                  tbflInvalidUserOrPass,
                                  tbflSocketError,
                                  tbflUserError,       // ie invalide password/username
                                  tbflNoAuthURLFound);


const
     CNT_BOARD_SOCKET_ERROR = -2;
     CNT_BOARD_CHALLENGE_NOT_FOUND = -7;
     CNT_BOARD_CLOSED       = -3;


     // 5 jours
     CNT_BOARD_VALIDITE_IDENT = 3600 * 24 * 5;

     // 2 jours
     CNT_BOARD_RELOG_BEFORE_EXPIRATION = 3600 * 24 * 2;

     // 10 jours
     CNT_BOARD_UPDATE_FILE_PERIMED_IF_FAIL = 3600 * 24 * 10;

     
type
     TBoardMotor = class(TObject)
     private
        FLoginEmail   : string;
        FLoginPassword: string;

        FHtAccessUser : string;
        FHtAccessPass : string;

        FBoardSession : string;

        FWebSocket    : THttpCli;

        // à partir du login, on récupére les URL
        // de localisation des catégories et forums

        FTempPageWeb  : string;

        FDebugProc  : TsfcProcStatus;
        FStatusProc : TsfcProcStatus;


        procedure DoDebug(Msg: string);
        procedure DoStatus(Msg: string);

        function ExtractKeyValueFromWebPage(Key: string): string;

     public
        property SocketWeb : THttpCli     read FWebSocket;
        property DebugProc : TsfcProcStatus   write FDebugProc;
        property LoginEmail: string read FLoginEmail    write FLoginEmail;
        property LoginPass : string read FLoginPassword write FLoginPassword;


        function Login(URL: string): integer;

        constructor Create;
        destructor Destroy; override;
     end;


implementation


function TBoardMotor.Login(URL: string): integer;
var Data, ChallengeId, sOfs, sSecu, md5email: string;
begin

     Result := -1;

     md5email := md5StringX(FLoginEmail);

     Data := BOARD_VAR_IN_USERNAME_MASTERID + '=' + md5email + '&' +
             BOARD_VAR_IN_OPERATION_TODO    + '=' + BOARD_VAL_OPERATION_TODO_GETAUTH;

     //DoDebug('Login, GetAuth, données postés: ' + Data);

     FTempPageWeb := gzhttpGETorPOST_InTamponX(URL, Data, FWebSocket);

     if FTempPageWeb = modDL_ERREUR_DL_STR then begin
        // erreur de téléchargement, réessaye...
        FTempPageWeb := gzhttpGETorPOST_InTamponX(URL, Data, FWebSocket);

        if FTempPageWeb = modDL_ERREUR_DL_STR then begin
           // le site doit être indisponible
           Result := CNT_BOARD_SOCKET_ERROR;
           exit;
        end;

     end;

     if FWebSocket.StatusCode <> 200 then begin
        // erreur...
        // le site a du être fermé
        Result := CNT_BOARD_CLOSED;
        exit;
     end;

     // tout est ok, on analyse la page web
     // sachant que dans celle-ci se trouve certainement la publicité
     // de l'hébergeur
     //DoDebug('Login, GetAuth, données reçues: ' + FTempPageWeb);


     // extrait la chaine de challenge:
     ChallengeId := ExtractKeyValueFromWebPage(BOARD_VAR_OUT_CHALLENGEID);
     //DoDebug('ChallengeId: ' + ChallengeId);

     if (length(ChallengeId) < 10) or (length(ChallengeId) > 32) then begin
        // page error
        Result := CNT_BOARD_CHALLENGE_NOT_FOUND;
        exit;
     end;

     // calcul le resultat
     // en php on a:
     // $str_check = md5($u_mdp . $u_mdprnd . $u_mdp);
     // avec $u_mdp qui correspond au md5 du mot de passe
     sSecu := md5StringX(FLoginPassword);
     sSecu := md5StringX(sSecu + ChallengeId + sSecu);

     // la chaine doit cependant faire 64 octets
     // on doit envoyer une chaine du genre:
     // X<realchaine>XXXXXXXXXXXXXX
     sOfs := md5StringX(DateTimeToStr(Now));

     Data := copy(sOfs, 1, 2) + sSecu;
     System.Delete(sOfs, 1, 2);
     Data := Data + sOfs;
     sOfs := '';
     
     Data := BOARD_VAR_IN_USERNAME_MASTERID + '=' + md5email + '&' +
             BOARD_VAR_IN_AUTH_HASH + '=' + Data + '&' +
             BOARD_VAR_IN_OPERATION_TODO    + '=' + BOARD_VAL_OPERATION_TODO_VERIFAUTH;


     //DoDebug('Login, FinalAuth, données postés: ' + Data);

     FTempPageWeb := gzhttpGETorPOST_InTamponX(URL, Data, FWebSocket);

     if FWebSocket.StatusCode <> 200 then begin
        // erreur...
        // bien qu'impossible car sinon on l'aurait rencontrée avant
        Result := -30;
        exit;
     end;

     //DoDebug('Login, FinalAuth, données reçues: ' + FTempPageWeb);


     FBoardSession := ExtractKeyValueFromWebPage(BOARD_VAR_OUT_SESSIONID);

     if length(FBoardSession) = 32 then begin
        Result := 1;
        FWebSocket.Cookie := BOARD_COOK_SESSIONID + '=' + FBoardSession;
     end else begin
        Result := -39;
     end;

end;


function TBoardMotor.ExtractKeyValueFromWebPage(Key: string): string;
var xPos, xPos2: integer;
    lKey, lValue: string;
begin

(*
    // une valeur n'est JAMAIS sur la première ligne
    xPos := pos(#$0A, FTempPageWeb);
    if xPos = 0 then break;
    System.Delete(FTempPageWeb, 1, xPos);
*)

    Result := '';

    repeat
        xPos := pos(#$0A, FTempPageWeb);
        if xPos = 0 then break;
        if xPos < 100 then begin
           // si supérieur ou égal à 100 alors ce n'est pas une ligne
           // de clé, et on ignore
           xPos2 := pos('=', FTempPageWeb);

           if xPos2 < xPos then begin
              // c'est peut-être une ligne de clé

              lKey := copy(FTempPageWeb, 1, xPos2 - 1);

              if SameText(lKey, Key) then begin
                 // ca correspond
                 Result := trim(copy(FTempPageWeb, xPos2 + 1, xPos - xPos2 - 1));
                 exit;
              end;


           end;




        end;

        // ce n'est pas une ligne de clé
        System.Delete(FTempPageWeb, 1, xPos);


    until False;

end;


constructor TBoardMotor.Create;
begin
    inherited Create;

    FWebSocket    := THttpCli.Create(nil);

    FDebugProc  := nil;
    FStatusProc := nil;

end;


destructor TBoardMotor.Destroy;
begin
    if FWebSocket <> nil then begin
       FWebSocket.Free;
       FWebSocket := nil;
    end;


    inherited Destroy;
end;


procedure TBoardMotor.DoDebug(Msg: string);
begin
    if Assigned(FDebugProc) then
       FDebugProc(Msg);

end;

procedure TBoardMotor.DoStatus(Msg: string);
begin
    if Assigned(FStatusProc) then
       FStatusProc(Msg);
end;

end.
